home *** CD-ROM | disk | FTP | other *** search
/ Mac Easy 2010 May / Mac Life Ubuntu.iso / casper / filesystem.squashfs / usr / bin / xscreensaver-text < prev    next >
Encoding:
Text File  |  2008-10-24  |  24.5 KB  |  850 lines
  1. #!/usr/bin/perl -w
  2. # Copyright © 2005-2008 Jamie Zawinski <jwz@jwz.org>
  3. #
  4. # Permission to use, copy, modify, distribute, and sell this software and its
  5. # documentation for any purpose is hereby granted without fee, provided that
  6. # the above copyright notice appear in all copies and that both that
  7. # copyright notice and this permission notice appear in supporting
  8. # documentation.  No representations are made about the suitability of this
  9. # software for any purpose.  It is provided "as is" without express or 
  10. # implied warranty.
  11. #
  12. # This program writes some text to stdout, based on preferences in the
  13. # .xscreensaver file.  It may load a file, a URL, run a program, or just
  14. # print the date.
  15. #
  16. # In a native MacOS build of xscreensaver, this script is included in
  17. # the Contents/Resources/ directory of each screen saver .bundle that
  18. # uses it; and in that case, it looks up its resources using
  19. # /usr/bin/defaults instead.
  20. #
  21. # Created: 19-Mar-2005.
  22.  
  23. require 5;
  24. #use diagnostics;    # Fails on some MacOS 10.5 systems
  25. use strict;
  26.  
  27. use Socket;
  28. use POSIX qw(strftime);
  29. use Text::Wrap qw(wrap);
  30. use bytes;
  31.  
  32. my $progname = $0; $progname =~ s@.*/@@g;
  33. my $version = q{ $Revision: 1.15 $ }; $version =~ s/^[^0-9]+([0-9.]+).*$/$1/;
  34.  
  35. my $verbose = 0;
  36. my $http_proxy = undef;
  37.  
  38. my $config_file = $ENV{HOME} . "/.xscreensaver";
  39. my $text_mode     = 'date';
  40. my $text_literal  = '';
  41. my $text_file     = '';
  42. my $text_program  = '';
  43. my $text_url      = '';
  44.  
  45. my $wrap_columns  = undef;
  46. my $nyarlathotep_p = 0;
  47.  
  48.  
  49. # Maps HTML character entities to the corresponding Latin1 characters.
  50. #
  51. my %entity_table = (
  52.    "quot"   => '"', "amp"    => '&', "lt"     => '<', "gt"     => '>',
  53.    "nbsp"   => ' ', "iexcl"  => '°', "cent"   => '¢', "pound"  => '£',
  54.    "curren" => '§', "yen"    => '•', "brvbar" => '¶', "sect"   => 'ß',
  55.    "uml"    => '®', "copy"   => '©', "ordf"   => '™', "laquo"  => '´',
  56.    "not"    => '¨', "shy"    => '≠', "reg"    => 'Æ', "macr"   => 'Ø',
  57.    "deg"    => '∞', "plusmn" => '±', "sup2"   => '≤', "sup3"   => '≥',
  58.    "acute"  => '¥', "micro"  => 'µ', "para"   => '∂', "middot" => '∑',
  59.    "cedil"  => '∏', "sup1"   => 'π', "ordm"   => '∫', "raquo"  => 'ª',
  60.    "frac14" => 'º', "frac12" => 'Ω', "frac34" => 'æ', "iquest" => 'ø',
  61.    "Agrave" => '¿', "Aacute" => '¡', "Acirc"  => '¬', "Atilde" => '√',
  62.    "Auml"   => 'ƒ', "Aring"  => '≈', "AElig"  => 'Δ', "Ccedil" => '«',
  63.    "Egrave" => '»', "Eacute" => '…', "Ecirc"  => ' ', "Euml"   => 'À',
  64.    "Igrave" => 'Ã', "Iacute" => 'Õ', "Icirc"  => 'Œ', "Iuml"   => 'œ',
  65.    "ETH"    => '–', "Ntilde" => '—', "Ograve" => '“', "Oacute" => '”',
  66.    "Ocirc"  => '‘', "Otilde" => '’', "Ouml"   => '÷', "times"  => '◊',
  67.    "Oslash" => 'ÿ', "Ugrave" => 'Ÿ', "Uacute" => '⁄', "Ucirc"  => '€',
  68.    "Uuml"   => '‹', "Yacute" => '›', "THORN"  => 'fi', "szlig"  => 'fl',
  69.    "agrave" => '‡', "aacute" => '·', "acirc"  => '‚', "atilde" => '„',
  70.    "auml"   => '‰', "aring"  => 'Â', "aelig"  => 'Ê', "ccedil" => 'Á',
  71.    "egrave" => 'Ë', "eacute" => 'È', "ecirc"  => 'Í', "euml"   => 'Î',
  72.    "igrave" => 'Ï', "iacute" => 'Ì', "icirc"  => 'Ó', "iuml"   => 'Ô',
  73.    "eth"    => '', "ntilde" => 'Ò', "ograve" => 'Ú', "oacute" => 'Û',
  74.    "ocirc"  => 'Ù', "otilde" => 'ı', "ouml"   => 'ˆ', "divide" => '˜',
  75.    "oslash" => '¯', "ugrave" => '˘', "uacute" => '˙', "ucirc"  => '˚',
  76.    "uuml"   => '¸', "yacute" => '˝', "thorn"  => '˛', "yuml"   => 'ˇ',
  77.    "apos"   => '\''
  78. );
  79.  
  80. # Maps certain UTF8 characters (2 or 3 bytes) to the corresponding
  81. # Latin1 characters.
  82. #
  83. my %unicode_latin1_table = (
  84.    "\xC2\xA1" => '°', "\xC2\xA2" => '¢', "\xC2\xA3" => '£', "\xC2\xA4" => '§',
  85.    "\xC2\xA5" => '•', "\xC2\xA6" => '¶', "\xC2\xA7" => 'ß', "\xC2\xA8" => '®',
  86.    "\xC2\xA9" => '©', "\xC2\xAA" => '™', "\xC2\xAB" => '´', "\xC2\xAC" => '¨',
  87.    "\xC2\xAD" => '≠', "\xC2\xAE" => 'Æ', "\xC2\xAF" => 'Ø', "\xC2\xB0" => '∞',
  88.    "\xC2\xB1" => '±', "\xC2\xB2" => '≤', "\xC2\xB3" => '≥', "\xC2\xB4" => '¥',
  89.    "\xC2\xB5" => 'µ', "\xC2\xB6" => '∂', "\xC2\xB7" => '∑', "\xC2\xB8" => '∏',
  90.    "\xC2\xB9" => 'π', "\xC2\xBA" => '∫', "\xC2\xBB" => 'ª', "\xC2\xBC" => 'º',
  91.    "\xC2\xBD" => 'Ω', "\xC2\xBE" => 'æ', "\xC2\xBF" => 'ø', "\xC3\x80" => '¿',
  92.    "\xC3\x81" => '¡', "\xC3\x82" => '¬', "\xC3\x83" => '√', "\xC3\x84" => 'ƒ',
  93.    "\xC3\x85" => '≈', "\xC3\x86" => 'Δ', "\xC3\x87" => '«', "\xC3\x88" => '»',
  94.    "\xC3\x89" => '…', "\xC3\x8A" => ' ', "\xC3\x8B" => 'À', "\xC3\x8C" => 'Ã',
  95.    "\xC3\x8D" => 'Õ', "\xC3\x8E" => 'Œ', "\xC3\x8F" => 'œ', "\xC3\x90" => '–',
  96.    "\xC3\x91" => '—', "\xC3\x92" => '“', "\xC3\x93" => '”', "\xC3\x94" => '‘',
  97.    "\xC3\x95" => '’', "\xC3\x96" => '÷', "\xC3\x97" => '◊', "\xC3\x98" => 'ÿ',
  98.    "\xC3\x99" => 'Ÿ', "\xC3\x9A" => '⁄', "\xC3\x9B" => '€', "\xC3\x9C" => '‹',
  99.    "\xC3\x9D" => '›', "\xC3\x9E" => 'fi', "\xC3\x9F" => 'fl', "\xC3\xA0" => '‡',
  100.    "\xC3\xA1" => '·', "\xC3\xA2" => '‚', "\xC3\xA3" => '„', "\xC3\xA4" => '‰',
  101.    "\xC3\xA5" => 'Â', "\xC3\xA6" => 'Ê', "\xC3\xA7" => 'Á', "\xC3\xA8" => 'Ë',
  102.    "\xC3\xA9" => 'È', "\xC3\xAA" => 'Í', "\xC3\xAB" => 'Î', "\xC3\xAC" => 'Ï',
  103.    "\xC3\xAD" => 'Ì', "\xC3\xAE" => 'Ó', "\xC3\xAF" => 'Ô', "\xC3\xB0" => '',
  104.    "\xC3\xB1" => 'Ò', "\xC3\xB2" => 'Ú', "\xC3\xB3" => 'Û', "\xC3\xB4" => 'Ù',
  105.    "\xC3\xB5" => 'ı', "\xC3\xB6" => 'ˆ', "\xC3\xB7" => '˜', "\xC3\xB8" => '¯',
  106.    "\xC3\xB9" => '˘', "\xC3\xBA" => '˙', "\xC3\xBB" => '˚', "\xC3\xBC" => '¸',
  107.    "\xC3\xBD" => '˝', "\xC3\xBE" => '˛', "\xC3\xBF" => 'ˇ',
  108.  
  109.    "\xE2\x80\x93" => '--',  "\xE2\x80\x94" => '--',
  110.    "\xE2\x80\x98" => '`',   "\xE2\x80\x99" => '\'',
  111.    "\xE2\x80\x9C" => "``",  "\xE2\x80\x9D" => "''",
  112.    "\xE2\x80\xA6" => '...',
  113. );
  114.  
  115.  
  116. # Convert any HTML entities to Latin1 characters.
  117. #
  118. sub de_entify($) {
  119.   my ($text) = @_;
  120.   $text =~ s/(&(\#)?([[:alpha:]\d]+);?)/
  121.     {
  122.      my $c;
  123.      if ($2) {
  124.        $c = chr($3);  # the &#number is always decimal, right?
  125.      } else {
  126.        $c = $entity_table{$3};
  127.      }
  128. #    print STDERR "$progname: warning: unknown HTML character entity \"$1\"\n"
  129. #     unless $c;
  130.      ($c ? $c : "[$3]");
  131.     }
  132.    /gexi;
  133.   return $text;
  134. }
  135.  
  136.  
  137. # Convert any Unicode characters to Latin1 if possible.
  138. # Unconvertable bytes are left alone.
  139. #
  140. sub de_unicoddle($) {
  141.   my ($text) = @_;
  142.   foreach my $key (keys (%unicode_latin1_table)) {
  143.     my $val = $unicode_latin1_table{$key};
  144.     $text =~ s/$key/$val/gs;
  145.   }
  146.   return $text;
  147. }
  148.  
  149.  
  150. # Reads the prefs we use from ~/.xscreensaver
  151. #
  152. sub get_x11_prefs() {
  153.   my $got_any_p = 0;
  154.   local *IN;
  155.  
  156.   if (open (IN, "<$config_file")) {
  157.     print STDERR "$progname: reading $config_file\n" if ($verbose > 1);
  158.     my $body = '';
  159.     while (<IN>) { $body .= $_; }
  160.     close IN;
  161.     $got_any_p = get_x11_prefs_1 ($body);
  162.  
  163.   } elsif ($verbose > 1) {
  164.     print STDERR "$progname: $config_file: $!\n";
  165.   }
  166.  
  167.   if (! $got_any_p && defined ($ENV{DISPLAY})) {
  168.     # We weren't able to read settings from the .xscreensaver file.
  169.     # Fall back to any settings in the X resource database
  170.     # (/usr/X11R6/lib/X11/app-defaults/XScreenSaver)
  171.     #
  172.     print STDERR "$progname: reading X resources\n" if ($verbose > 1);
  173.     my $body = `appres XScreenSaver xscreensaver -1`;
  174.     $got_any_p = get_x11_prefs_1 ($body);
  175.   }
  176.  
  177.   if ($verbose > 1) {
  178.     printf STDERR "$progname: mode:    $text_mode\n";
  179.     printf STDERR "$progname: literal: $text_literal\n";
  180.     printf STDERR "$progname: file:    $text_file\n";
  181.     printf STDERR "$progname: program: $text_program\n";
  182.     printf STDERR "$progname: url:     $text_url\n";
  183.   }
  184.  
  185.   $text_mode =~ tr/A-Z/a-z/;
  186.   $text_literal =~ s@\\n@\n@gs;
  187. }
  188.  
  189.  
  190. sub get_x11_prefs_1($) {
  191.   my ($body) = @_;
  192.  
  193.   my $got_any_p = 0;
  194.   $body =~ s@\\\n@@gs;
  195.  
  196.   if ($body =~ m/^[.*]*textMode:[ \t]*([^\s]+)\s*$/im) {
  197.     $text_mode = $1;
  198.     $got_any_p = 1;
  199.   }
  200.   if ($body =~ m/^[.*]*textLiteral:[ \t]*(.*?)[ \t]*$/im) {
  201.     $text_literal = $1;
  202.   }
  203.   if ($body =~ m/^[.*]*textFile:[ \t]*(.*?)[ \t]*$/im) {
  204.     $text_file = $1;
  205.   }
  206.   if ($body =~ m/^[.*]*textProgram:[ \t]*(.*?)[ \t]*$/im) {
  207.     $text_program = $1;
  208.   }
  209.   if ($body =~ m/^[.*]*textURL:[ \t]*(.*?)[ \t]*$/im) {
  210.     $text_url = $1;
  211.   }
  212.  
  213.   return $got_any_p;
  214. }
  215.  
  216.  
  217. sub get_cocoa_prefs($) {
  218.   my ($id) = @_;
  219.   my $v;
  220.  
  221.   print STDERR "$progname: reading Cocoa prefs: \"$id\"\n" if ($verbose > 1);
  222.  
  223.   $v = get_cocoa_pref_1 ($id, "textMode");
  224.   $text_mode = $v if defined ($v);
  225.  
  226.   # The "textMode" pref is set to a number instead of a string because I
  227.   # can't figure out the black magic to make Cocoa bindings work right.
  228.   #
  229.   if    ($text_mode eq '0') { $text_mode = 'date';    }
  230.   elsif ($text_mode eq '1') { $text_mode = 'literal'; }
  231.   elsif ($text_mode eq '2') { $text_mode = 'file';    }
  232.   elsif ($text_mode eq '3') { $text_mode = 'url';     }
  233.  
  234.   $v = get_cocoa_pref_1 ($id, "textLiteral");
  235.   $text_literal = $v if defined ($v);
  236.  
  237.   $v = get_cocoa_pref_1 ($id, "textFile");
  238.   $text_file = $v if defined ($v);
  239.  
  240.   $v = get_cocoa_pref_1 ($id, "textProgram");
  241.   $text_program = $v if defined ($v);
  242.  
  243.   $v = get_cocoa_pref_1 ($id, "textURL");
  244.   $text_url = $v if defined ($v);
  245. }
  246.  
  247.  
  248. sub get_cocoa_pref_1($$) {
  249.   my ($id, $key) = @_;
  250.   # make sure there's nothing stupid/malicious in either string.
  251.   $id  =~ s/[^-a-z\d. ]/_/gsi;
  252.   $key =~ s/[^-a-z\d. ]/_/gsi;
  253.   my $cmd = "defaults -currentHost read \"$id\" \"$key\"";
  254.  
  255.   print STDERR "$progname: executing $cmd\n"
  256.     if ($verbose > 3);
  257.  
  258.   my $val = `$cmd 2>/dev/null`;
  259.   $val =~ s/^\s+//s;
  260.   $val =~ s/\s+$//s;
  261.  
  262.   print STDERR "$progname: Cocoa: $id $key = \"$val\"\n"
  263.     if ($verbose > 2);
  264.  
  265.   $val = undef if ($val =~ m/^$/s);
  266.  
  267.   return $val;
  268. }
  269.  
  270.  
  271. # like system() but checks errors.
  272. #
  273. sub safe_system(@) {
  274.   my (@cmd) = @_;
  275.  
  276.   print STDERR "$progname: executing " . join(' ', @cmd) . "\n"
  277.     if ($verbose > 3);
  278.  
  279.   system @cmd;
  280.   my $exit_value  = $? >> 8;
  281.   my $signal_num  = $? & 127;
  282.   my $dumped_core = $? & 128;
  283.   error ("$cmd[0]: core dumped!") if ($dumped_core);
  284.   error ("$cmd[0]: signal $signal_num!") if ($signal_num);
  285.   error ("$cmd[0]: exited with $exit_value!") if ($exit_value);
  286. }
  287.  
  288.  
  289. sub which($) {
  290.   my ($cmd) = @_;
  291.  
  292.   if ($cmd =~ m@^\./|^/@) {
  293.     error ("cannot execute $cmd") unless (-x $cmd);
  294.     return $cmd;
  295.   }
  296.  
  297.  foreach my $dir (split (/:/, $ENV{PATH})) {
  298.     my $cmd2 = "$dir/$cmd";
  299.     print STDERR "$progname:   checking $cmd2\n" if ($verbose > 3);
  300.     return $cmd2 if (-x "$cmd2");
  301.   }
  302.   error ("$cmd not found on \$PATH");
  303. }
  304.  
  305.  
  306. sub output() {
  307.  
  308.   # Do some basic sanity checking (null text, null file names, etc.)
  309.   #
  310.   if (($text_mode eq 'literal' && $text_literal =~ m/^\s*$/i) ||
  311.       ($text_mode eq 'file'    && $text_file    =~ m/^\s*$/i) ||
  312.       ($text_mode eq 'program' && $text_program =~ m/^\s*$/i) ||
  313.       ($text_mode eq 'url'     && $text_url     =~ m/^\s*$/i)) {
  314.     print STDERR "$progname: falling back to 'date'\n" if ($verbose);
  315.     $text_mode = 'date';
  316.   }
  317.  
  318.   if ($text_mode eq 'literal') {
  319.     $text_literal = strftime ($text_literal, localtime);
  320.     $text_literal =~ y/A-Za-z/N-ZA-Mn-za-m/ if ($nyarlathotep_p);
  321.     print STDOUT $text_literal;
  322.     print STDOUT "\n" unless ($text_literal =~ m/\n$/s);
  323.  
  324.   } elsif ($text_mode eq 'file') {
  325.  
  326.     $text_file =~ s@^~/@$ENV{HOME}/@s;     # allow literal "~/"
  327.  
  328.     local *IN;
  329.     if (open (IN, "<$text_file")) {
  330.       print STDERR "$progname: reading $text_file\n" if ($verbose);
  331.  
  332.       if ($wrap_columns && $wrap_columns > 0) {
  333.         # read it, then reformat it.
  334.         my $body = '';
  335.         while (<IN>) { $body .= $_; }
  336.         reformat_text ($body);
  337.       } else {
  338.         # stream it
  339.         while (<IN>) { 
  340.           y/A-Za-z/N-ZA-Mn-za-m/ if ($nyarlathotep_p);
  341.           print $_;
  342.         }
  343.       }
  344.       close IN;
  345.     } else {
  346.       error ("$text_file: $!");
  347.     }
  348.  
  349.   } elsif ($text_mode eq 'program') {
  350.  
  351.     my ($prog, $args) = ($text_program =~ m/^([^\s]+)(.*)$/);
  352.     $text_program = which ($prog) . $args;
  353.     print STDERR "$progname: running $text_program\n" if ($verbose);
  354.  
  355.     if ($wrap_columns && $wrap_columns > 0) {
  356.       # read it, then reformat it.
  357.       my $body = `( $text_program ) 2>&1`;
  358.       reformat_text ($body);
  359.     } else {
  360.       # stream it
  361.       safe_system ("$text_program");
  362.     }
  363.  
  364.   } elsif ($text_mode eq 'url') {
  365.  
  366.     get_url_text ($text_url);
  367.  
  368.   } else { # $text_mode eq 'date'
  369.  
  370.     safe_system ("uname", "-n");
  371.  
  372.     my $unamep = 1;
  373.  
  374.     if (-f "/etc/redhat-release") {        # "Fedora Core release 4 (Stentz)"
  375.       system ("cat", "/etc/redhat-release");
  376.     }
  377.  
  378.     if (-f "/etc/release") {                # "Solaris 10 3/05 s10_74L2a X86"
  379.       safe_system ("head", "-1", "/etc/release");
  380.     }
  381.  
  382.     if (-f "/usr/sbin/system_profiler") {   # "Mac OS X 10.4.5 (8H14)"
  383.       my $sp =                    # "iMac G5"
  384.         `/usr/sbin/system_profiler SPSoftwareDataType SPHardwareDataType`;
  385.       my ($v) = ($sp =~ m/^\s*System Version:\s*(.*)$/mi);
  386.       my ($s) = ($sp =~ m/^\s*CPU Speed:\s*(.*)$/mi);
  387.       my ($t) = ($sp =~ m/^\s*Machine Name:\s*(.*)$/mi);
  388.       print "$v\n" if ($v);
  389.       print "$s $t\n" if ($s && $t);
  390.       $unamep = !defined ($v);
  391.     }
  392.  
  393.     if ($unamep) {
  394.       safe_system ("uname", "-sr");        # "Linux 2.6.15-1.1831_FC4"
  395.     }
  396.  
  397.     print "\n";
  398.     safe_system ("date", "+%c");
  399.     print "\n";
  400.     my $ut = `uptime`;
  401.     $ut =~ s/^[ \d:]*(am|pm)?//i;
  402.     $ut =~ s/,\s*(load)/\n$1/;
  403.     print "$ut\n";
  404.   }
  405.  
  406. }
  407.  
  408.  
  409. # Loads the given URL, returns: $http, $head, $body.
  410. #
  411. sub get_url_1($;$) {
  412.   my ($url, $referer) = @_;
  413.   
  414.   if (! ($url =~ m@^(http|feed)://@i)) {
  415.     error ("not an HTTP URL: $url");
  416.   }
  417.  
  418.   my ($url_proto, $dummy, $serverstring, $path) = split(/\//, $url, 4);
  419.   $path = "" unless $path;
  420.  
  421.   my ($them,$port) = split(/:/, $serverstring);
  422.   $port = 80 unless $port;
  423.  
  424.   my $them2 = $them;
  425.   my $port2 = $port;
  426.   if ($http_proxy) {
  427.     $serverstring = $http_proxy if $http_proxy;
  428.     $serverstring =~ s@^[a-z]+://@@;
  429.     ($them2,$port2) = split(/:/, $serverstring);
  430.     $port2 = 80 unless $port2;
  431.   }
  432.  
  433.   my ($remote, $iaddr, $paddr, $proto, $line);
  434.   $remote = $them2;
  435.   if ($port2 =~ /\D/) { $port2 = getservbyname($port2, 'tcp') }
  436.   if (!$port2) {
  437.     error ("unrecognised port in $url");
  438.   }
  439.  
  440.   $iaddr = inet_aton($remote);
  441.   error ("host not found: $remote") unless ($iaddr);
  442.  
  443.   $paddr   = sockaddr_in($port2, $iaddr);
  444.  
  445.  
  446.   my $head = "";
  447.   my $body = "";
  448.  
  449.   $proto   = getprotobyname('tcp');
  450.   if (!socket(S, PF_INET, SOCK_STREAM, $proto)) {
  451.     error ("socket: $!");
  452.   }
  453.   if (!connect(S, $paddr)) {
  454.     error ("connect($serverstring): $!");
  455.   }
  456.  
  457.   select(S); $| = 1; select(STDOUT);
  458.  
  459.   my $user_agent = "$progname/$version";
  460.  
  461.   my $hdrs = ("GET " . ($http_proxy ? $url : "/$path") . " HTTP/1.0\r\n" .
  462.               "Host: $them\r\n" .
  463.               "User-Agent: $user_agent\r\n");
  464.   if ($referer) {
  465.     $hdrs .= "Referer: $referer\r\n";
  466.   }
  467.   $hdrs .= "\r\n";
  468.  
  469.   if ($verbose > 3) {
  470.     foreach (split('\r?\n', $hdrs)) {
  471.       print STDERR "  ==> $_\n";
  472.     }
  473.   }
  474.   print S $hdrs;
  475.   my $http = <S> || "";
  476.  
  477.   $_  = $http;
  478.   s/[\r\n]+$//s;
  479.   print STDERR "  <== $_\n" if ($verbose > 3);
  480.  
  481.   while (<S>) {
  482.     $head .= $_;
  483.     s/[\r\n]+$//s;
  484.     last if m@^$@;
  485.     print STDERR "  <== $_\n" if ($verbose > 3);
  486.   }
  487.  
  488.   print STDERR "  <== \n" if ($verbose > 4);
  489.   my $lines = 0;
  490.   while (<S>) {
  491.     s/\r\n/\n/gs;
  492.     print STDERR "  <== $_" if ($verbose > 4);
  493.     $body .= $_;
  494.     $lines++;
  495.   }
  496.  
  497.   print STDERR "  <== [ body ]: $lines lines, " . length($body) . " bytes\n"
  498.     if ($verbose == 4);
  499.  
  500.   close S;
  501.  
  502.   if (!$http) {
  503.     error ("null response: $url");
  504.   }
  505.  
  506.   return ( $http, $head, $body );
  507. }
  508.  
  509.  
  510. # Loads the given URL, processes redirects, returns (content-type, body).
  511. #
  512. sub get_url($;$) {
  513.   my ($url, $referer) = @_;
  514.  
  515.   print STDERR "$progname: loading $url\n" if ($verbose > 2);
  516.  
  517.   my $orig_url = $url;
  518.   my $loop_count = 0;
  519.   my $max_loop_count = 10;
  520.  
  521.   do {
  522.     my ( $http, $head, $body ) = get_url_1 ($url, $referer);
  523.  
  524.     $http =~ s/[\r\n]+$//s;
  525.  
  526.     if ( $http =~ m@^HTTP/[0-9.]+ 30[123]@ ) {
  527.       $_ = $head;
  528.  
  529.       my ( $location ) = m@^location:[ \t]*(.*)$@im;
  530.       if ( $location ) {
  531.         $location =~ s/[\r\n]$//;
  532.  
  533.         print STDERR "$progname: redirect from $url to $location\n"
  534.           if ($verbose > 3);
  535.  
  536.         $referer = $url;
  537.         $url = $location;
  538.  
  539.         if ($url =~ m@^/@) {
  540.           $referer =~ m@^(http://[^/]+)@i;
  541.           $url = $1 . $url;
  542.         } elsif (! ($url =~ m@^[a-z]+:@i)) {
  543.           $_ = $referer;
  544.           s@[^/]+$@@g if m@^http://[^/]+/@i;
  545.           $_ .= "/" if m@^http://[^/]+$@i;
  546.           $url = $_ . $url;
  547.         }
  548.  
  549.       } else {
  550.         error ("no Location with \"$http\"");
  551.       }
  552.  
  553.       if ($loop_count++ > $max_loop_count) {
  554.         error ("too many redirects ($max_loop_count) from $orig_url");
  555.       }
  556.  
  557.     } elsif ( $http =~ m@^HTTP/[0-9.]+ ([4-9][0-9][0-9].*)$@ ) {
  558.       error ("failed: $1 ($url)");
  559.  
  560.     } else {
  561.       my $ct = 'text/plain';
  562.       $ct = $1 if ($head =~ m/^content-type:\s*([^\s]+)/mi);
  563.       return ($ct, $body);
  564.     }
  565.   } while (1);
  566. }
  567.  
  568.  
  569. # Make an educated guess as to what's in this document.
  570. # We don't necessarily take the Content-Type header at face value.
  571. # Returns 'html', 'rss', or 'text';
  572. #
  573. sub guess_content_type($$) {
  574.   my ($ct, $body) = @_;
  575.  
  576.   $body =~ s/^(.{512}).*/$1/s;  # only look in first half K of file
  577.  
  578.   if ($ct =~ m@^text/.*html@i)          { return 'html'; }
  579.   if ($ct =~ m@\b(atom|rss|xml)\b@i)    { return 'rss';  }
  580.  
  581.   if ($body =~ m@^\s*<\?xml@is)         { return 'rss';  }
  582.   if ($body =~ m@^\s*<!DOCTYPE RSS@is)  { return 'rss';  }
  583.   if ($body =~ m@^\s*<!DOCTYPE HTML@is) { return 'html'; }
  584.  
  585.   if ($body =~ m@<(BASE|HTML|HEAD|BODY|SCRIPT|STYLE|TABLE|A\s+HREF)\b@i) {
  586.     return 'html';
  587.   }
  588.  
  589.   if ($body =~ m@<(RSS|CHANNEL|GENERATOR|DESCRIPTION|CONTENT|FEED|ENTRY)\b@i) {
  590.     return 'rss';
  591.   }
  592.  
  593.   return 'text';
  594. }
  595.  
  596. sub reformat_html($$) {
  597.   my ($body, $rss_p) = @_;
  598.   $_ = $body;
  599.  
  600.   if (! $rss_p) {
  601.     # In HTML, unfold lines (this breaks PRE.  Sue me.)
  602.     # In RSS, assume \n means literal line break.
  603.     s@[\r\n]@ @gsi;
  604.   }
  605.  
  606.   s@<!--.*?-->@@gsi;                 # lose comments
  607.   s@<(STYLE|SCRIPT)\b[^<>]*>.*?</\1\s*>@@gsi;    # lose css and js
  608.  
  609.   s@</?(BR|TR|TD|LI|DIV)\b[^<>]*>@\n@gsi; # line break at BR, TD, DIV, etc
  610.   s@</?(P|UL|OL|BLOCKQUOTE)\b[^<>]*>@\n\n@gsi; # two line breaks
  611.  
  612.   s@<lj\s+user=\"?([^<>\"]+)\"?[^<>]*>?@$1@gsi;  # handle <LJ USER=>
  613.   s@</?[BI]>@*@gsi;                         # bold, italic => asterisks
  614.  
  615.  
  616.   s@<[^<>]*>?@@gs;                # lose all other HTML tags
  617.   $_ = de_entify ($_);            # convert HTML entities
  618.  
  619.   # elide any remaining non-Latin1 binary data...
  620.   s/([\177-\377]+(\s*[\177-\377]+)[^a-z\d]*)/´...ª /g;
  621.   #s/([\177-\377]+(\s*[\177-\377]+)[^a-z\d]*)/´$1ª /g;
  622.  
  623.   $_ .= "\n";
  624.  
  625.   s/[ \t]+$//gm;                  # lose whitespace at end of line
  626.   s@\n\n\n+@\n\n@gs;              # compress blank lines
  627.  
  628.   if (!defined($wrap_columns) || $wrap_columns > 0) {
  629.     $Text::Wrap::columns = ($wrap_columns || 72);
  630.     $_ = wrap ("", "  ", $_);     # wrap the lines as a paragraph
  631.     s/[ \t]+$//gm;                # lose whitespace at end of line again
  632.   }
  633.  
  634.   y/A-Za-z/N-ZA-Mn-za-m/ if ($nyarlathotep_p);
  635.   print STDOUT $_;
  636. }
  637.  
  638.  
  639. sub reformat_rss($) {
  640.   my ($body) = @_;
  641.  
  642.   $body =~ s/(<(ITEM|ENTRY)\b)/\001\001$1/gsi;
  643.   my @items = split (/\001\001/, $body);
  644.  
  645.   print STDERR "$progname: converting RSS ($#items items)...\n"
  646.     if ($verbose > 2);
  647.  
  648.   shift @items;
  649.  
  650.   # Let's skip forward in the stream by a random amount, so that if
  651.   # two copies of ljlatest are running at the same time (e.g., on a
  652.   # multi-headed machine), they get different text.  (Put the items
  653.   # that we take off the front back on the back.)
  654.   #
  655.   if ($#items > 7) {
  656.     my $n = int (rand ($#items - 5));
  657.     print STDERR "$progname: rotating by $n items...\n" if ($verbose > 2);
  658.     while ($n-- > 0) {
  659.       push @items, (shift @items);
  660.     }
  661.   }
  662.  
  663.   my $i = -1;
  664.   foreach (@items) {
  665.     $i++;
  666.  
  667.     my ($title, $body1, $body2, $body3);
  668.     
  669.     $title = $3 if (m@<((TITLE)       [^<>\s]*)[^<>]*>\s*(.*?)\s*</\1>@xsi);
  670.     $body1 = $3 if (m@<((DESCRIPTION) [^<>\s]*)[^<>]*>\s*(.*?)\s*</\1>@xsi);
  671.     $body2 = $3 if (m@<((CONTENT)     [^<>\s]*)[^<>]*>\s*(.*?)\s*</\1>@xsi);
  672.     $body3 = $3 if (m@<((SUMMARY)     [^<>\s]*)[^<>]*>\s*(.*?)\s*</\1>@xsi);
  673.  
  674.     # If there are both <description> and <content> or <content:encoded>,
  675.     # use whichever one contains more text.
  676.     #
  677.     if ($body3 && length($body3) >= length($body2 || '')) {
  678.       $body2 = $body3;
  679.     }
  680.     if ($body2 && length($body2) >= length($body1 || '')) {
  681.       $body1 = $body2;
  682.     }
  683.  
  684.     if (! $body1) {
  685.       if ($title) {
  686.         print STDERR "$progname: no body in item $i (\"$title\")\n"
  687.           if ($verbose > 2);
  688.       } else {
  689.         print STDERR "$progname: no body or title in item $i\n"
  690.           if ($verbose > 2);
  691.         next;
  692.       }
  693.     }
  694.  
  695.     $title = rss_field_to_html ($title || '');
  696.     $body1 = rss_field_to_html ($body1 || '');
  697.  
  698.     reformat_html ("$title<P>$body1", 1);
  699.     print "\n";
  700.   }
  701. }
  702.  
  703.  
  704. sub rss_field_to_html($) {
  705.   my ($body) = @_;
  706.  
  707.   # Assume that if <![CDATA[...]]> is present, everything inside that.
  708.   #
  709.   if ($body =~ m/^\s*<!\[CDATA\[(.*?)\]\s*\]/is) {
  710.     $body = $1;
  711.   } else {
  712.     $body = de_entify ($body);      # convert entities to get HTML from XML
  713.   }
  714.  
  715.   $body = de_unicoddle ($body);     # convert UTF8 to Latin1
  716.   return $body;
  717. }
  718.  
  719.  
  720. sub reformat_text($) {
  721.   my ($body) = @_;
  722.  
  723.   # only re-wrap if --cols was specified.  Otherwise, dump it as is.
  724.   #
  725.   if ($wrap_columns && $wrap_columns > 0) {
  726.     print STDERR "$progname: wrapping at $wrap_columns...\n" if ($verbose > 2);
  727.     $Text::Wrap::columns = $wrap_columns;
  728.     $body = wrap ("", "", $body);
  729.     $body =~ s/[ \t]+$//gm;
  730.   }
  731.  
  732.   $body =~ y/A-Za-z/N-ZA-Mn-za-m/ if ($nyarlathotep_p);
  733.   print STDOUT $body;
  734. }
  735.  
  736.  
  737. sub get_url_text($) {
  738.   my ($url) = @_;
  739.  
  740.   # historical suckage: the environment variable name is lower case.
  741.   $http_proxy = $ENV{http_proxy} || $ENV{HTTP_PROXY};
  742.  
  743.   if ($http_proxy && $http_proxy =~ m@^http://([^/]*)/?$@ ) {
  744.     # historical suckage: allow "http://host:port" as well as "host:port".
  745.     $http_proxy = $1;
  746.   }
  747.  
  748.   my ($ct, $body) = get_url ($url);
  749.  
  750.   $ct = guess_content_type ($ct, $body);
  751.   if ($ct eq 'html') {
  752.     print STDERR "$progname: converting HTML...\n" if ($verbose > 2);
  753.     reformat_html ($body, 0);
  754.   } elsif ($ct eq 'rss')  {
  755.     reformat_rss ($body);
  756.   } else {
  757.     print STDERR "$progname: plain text...\n" if ($verbose > 2);
  758.     reformat_text ($body);
  759.   }
  760. }
  761.  
  762.  
  763.  
  764. sub error($) {
  765.   my ($err) = @_;
  766.   print STDERR "$progname: $err\n";
  767.   exit 1;
  768. }
  769.  
  770. sub usage() {
  771.   print STDERR "usage: $progname [ --options ... ]\n" .
  772.    ("\n" .
  773.     "       Prints out some text for use by various screensavers,\n" .
  774.     "       according to the options in the ~/.xscreensaver file.\n" .
  775.     "       This may dump the contents of a file, run a program,\n" .
  776.     "       or load a URL.\n".
  777.     "\n" .
  778.     "   Options:\n" .
  779.     "\n" .
  780.     "       --date           Print the host name and current time.\n" .
  781.     "\n" .
  782.     "       --text STRING    Print out the given text.  It may contain %\n" .
  783.     "                        escape sequences as per strftime(2).\n" .
  784.     "\n" .
  785.     "       --file PATH      Print the contents of the given file.\n" .
  786.     "                        If --cols is specified, re-wrap the lines;\n" .
  787.     "                        otherwise, print them as-is.\n" .
  788.     "\n" .
  789.     "       --program CMD    Run the given program and print its output.\n" .
  790.     "                        If --cols is specified, re-wrap the output.\n" .
  791.     "\n" .
  792.     "       --url HTTP-URL   Download and print the contents of the HTTP\n" .
  793.     "                        document.  If it contains HTML, RSS, or Atom,\n" .
  794.     "                        it will be converted to plain-text.\n" .
  795.     "\n" .
  796.     "       --cols N         Wrap lines at this column.  Default 72.\n" .
  797.     "\n");
  798.   exit 1;
  799. }
  800.  
  801. sub main() {
  802.  
  803.   my $load_p = 1;
  804.   my $cocoa_id = undef;
  805.  
  806.   while ($#ARGV >= 0) {
  807.     $_ = shift @ARGV;
  808.     if ($_ eq "--verbose") { $verbose++; }
  809.     elsif (m/^-v+$/) { $verbose += length($_)-1; }
  810.     elsif (m/^--?date$/)    { $text_mode = 'date';
  811.                               $load_p = 0; }
  812.     elsif (m/^--?text$/)    { $text_mode = 'literal';
  813.                               $text_literal = shift @ARGV;
  814.                               $load_p = 0; }
  815.     elsif (m/^--?file$/)    { $text_mode = 'file';
  816.                               $text_file = shift @ARGV;
  817.                               $load_p = 0; }
  818.     elsif (m/^--?program$/) { $text_mode = 'program';
  819.                               $text_program = shift @ARGV;
  820.                               $load_p = 0; }
  821.     elsif (m/^--?url$/)     { $text_mode = 'url';
  822.                               $text_url = shift @ARGV;
  823.                               $load_p = 0; }
  824.     elsif (m/^--?col(umn)?s?$/) { $wrap_columns = 0 + shift @ARGV; }
  825.     elsif (m/^--?cocoa$/)   { $cocoa_id = shift @ARGV; }
  826.     elsif (m/^--?nyarlathotep$/) { $nyarlathotep_p++; }
  827.     elsif (m/^-./) { usage; }
  828.     else { usage; }
  829.   }
  830.  
  831.   if ($load_p) {
  832.  
  833.     if (!defined ($cocoa_id)) {
  834.       # see OSX/XScreenSaverView.m
  835.       $cocoa_id = $ENV{XSCREENSAVER_CLASSPATH};
  836.     }
  837.  
  838.     if (defined ($cocoa_id)) {
  839.       get_cocoa_prefs($cocoa_id);
  840.     } else {
  841.       get_x11_prefs();
  842.     }
  843.   }
  844.  
  845.   output();
  846. }
  847.  
  848. main();
  849. exit 0;
  850.